home *** CD-ROM | disk | FTP | other *** search
/ Shareware Super Platinum 8 / Shareware Super Platinum 8.iso / mac / PROGTOOL / LIB211.ZIP;1 / FINANCE.PRG < prev    next >
Encoding:
Text File  |  1993-11-19  |  49.0 KB  |  1,180 lines
  1. *-----------------------------------------------------------------------
  2. *-- Program...: FINANCE.PRG
  3. *-- Programmer: Ken Mayer (CIS: 71333,1030)
  4. *-- Date......: 07/27/1993
  5. *-- Notes.....: These finance functions are for use with interest rates 
  6. *--             and such. See the file README.TXT for details about the
  7. *--             use of this library file.
  8. *--
  9. *--             NOTES ABOUT THESE ROUTINES (the ones written by Jay 
  10. *--             Parsons) The functions that use (1+nRate)^nPeriods 
  11. *--             require that the rate be stated in the same terms as the
  12. *--             compounding period. That is, for monthly compounding the 
  13. *--             nRate should be the annual rate / 12, and the nPeriods 
  14. *--             the number of months, and so forth.
  15. *--
  16. *--             If the situation involves continuous compounding, state
  17. *--             the rate as the exponent of the annual rate, less 1, and
  18. *--             state the periods in years.  Accordingly, to find the 
  19. *--             value in 30 months of a $1000 investment continuously 
  20. *--             compounded at 6%, use:
  21. *--                 FuturVal(1000,exp(.06)-1,30/12)
  22. *--
  23. *--             These functions (except NPV(), which sums a series of 
  24. *--             equal or unequal cash flows), are designed for use with 
  25. *--             a single "investment", one payment or receipt.  If the 
  26. *--             problem involves a series of equal payments or receipts 
  27. *--             like a mortgage loan, a Holiday Club or an annuity, the
  28. *--             fv() and pv() functions built in to dBASE IV should be 
  29. *--             used instead where possible.
  30. *-----------------------------------------------------------------------
  31.  
  32. FUNCTION Discount
  33. *-----------------------------------------------------------------------
  34. *-- Programmer..: Jay Parsons (CIS: 72662,1302)
  35. *-- Date........: 03/01/1992
  36. *-- Notes.......: Compute the present value of an amount to be received 
  37. *--               at the end of a number of periods given a periodic 
  38. *--               interest rate.
  39. *-- Written for.: dBASE IV, 1.1
  40. *-- Rev. History: 03/01/1992 -- Original Release
  41. *-- Calls.......: None
  42. *-- Called by...: Any
  43. *-- Usage.......: Discount(<nFuturVal>,<nRate>,<nPeriods>)
  44. *-- Example.....: ?Discount(1000,.08,6)
  45. *-- Returns.....: Numeric
  46. *-- Parameters..: nFuturVal = the amount to be received/paid in the 
  47. *--                           future
  48. *--               nRate     = the periodic rate of interest
  49. *--               nPeriods  = the number of periods
  50. *-----------------------------------------------------------------------
  51.  
  52.    parameters nFuturVal, nRate, nPeriods
  53.    
  54. RETURN m->nFuturVal / ( 1 + m->nRate ) ^ m->nPeriods
  55. *-- EoF: Discount()
  56.  
  57. FUNCTION FuturVal
  58. *-----------------------------------------------------------------------
  59. *-- Programmer..: Jay Parsons (CIS: 72662,1302)
  60. *-- Date........: 03/01/1992
  61. *-- Notes.......: Compute the future value of an initial amount at 
  62. *--               compound interest received at a given periodic rate 
  63. *--               for a number of periods.
  64. *-- Written for.: dBASE IV, 1.0
  65. *-- Rev. History: 03/01/1992 -- Original Release
  66. *-- Calls.......: None
  67. *-- Called by...: Any
  68. *-- Usage.......: FuturVal(<nPresVal>,<nRate>,<nPeriods>)
  69. *-- Example.....: ?FuturVal(10000,.06,48)
  70. *-- Returns.....: Numeric
  71. *-- Parameters..: nPresVal = Present Value
  72. *--               nRate    = Periodic interest rate
  73. *--               nPeriods = Number of periods to calculate for
  74. *-----------------------------------------------------------------------
  75.  
  76.    parameters nPresVal, nRate, nPeriods
  77.    
  78. RETURN m->nPresVal * ( 1 + m->nRate ) ^ m->nPeriods
  79. *-- EoF: FuturVal()
  80.  
  81. FUNCTION Rate
  82. *-----------------------------------------------------------------------
  83. *-- Programmer..: Jay Parsons (CIS: 72662,1302)
  84. *-- Date........: 03/01/1992
  85. *-- Notes.......: Compute rate of periodic interest needed to produce a 
  86. *--               future value from a present value in a given number of 
  87. *--               periods.  If the periods are not years, you'll 
  88. *--               probably want to multiply the rate returned by the 
  89. *--               number of periods in a year to obtain the equivalent
  90. *--               annual rate.
  91. *-- Written for.: dBASE IV, 1.1
  92. *-- Rev. History: 03/01/1992 -- Original Release
  93. *-- Calls.......: None
  94. *-- Called by...: Any
  95. *-- Usage.......: Rate(<nFutVal>,<nPresVal>,<nPeriods>)
  96. *-- Example.....: ?Rate(50000,10000,48)
  97. *-- Returns.....: Numeric
  98. *-- Parameters..: nFutVal  = Future Value
  99. *--               nPresVal = Present Value
  100. *--               nPeriods = Number of periods to calculate for
  101. *-----------------------------------------------------------------------
  102.  
  103.    parameters nFutVal, nPresVal, nPeriods
  104.    
  105. RETURN ( nFutVal / m->nPresVal ) ^ ( 1 / m->nPeriods ) - 1
  106. *-- EoF: Rate()
  107.  
  108. FUNCTION ContRate
  109. *-----------------------------------------------------------------------
  110. *-- Programmer..: Jay Parsons (CIS: 72662,1302)
  111. *-- Date........: 03/01/1992
  112. *-- Notes.......: Rate if compounding is continuous.  Periods must be 
  113. *--               years.
  114. *-- Written for.: dBASE IV, 1.1
  115. *-- Rev. History: 03/01/1992 -- Original Release
  116. *-- Calls.......: RATE()               Function in FINANCE.PRG
  117. *-- Called by...: Any
  118. *-- Usage.......: ContRate(<nFutVal>,<nPresVal>,<nYears>)
  119. *-- Example.....: ?ContRate(50000,10000,4)
  120. *-- Returns.....: Numeric
  121. *-- Parameters..: nFutVal  = Future Value
  122. *--               nPresVal = Present Value
  123. *--               nYears   = Number of years to calculate for
  124. *-----------------------------------------------------------------------
  125.  
  126.    parameters nFutVal, nPresVal, nYears
  127.    
  128. RETURN log( 1 + Rate( m->nFutVal, m->nPresVal, m->nYears ) )
  129. *-- EoF: ContRate()
  130.  
  131. FUNCTION NPV
  132. *-----------------------------------------------------------------------
  133. *-- Programmer..: Tony Lima (CIS: 72331,3724) and 
  134. *--               Jay Parsons (CIS: 72662,1302)
  135. *-- Date........: 03/01/1992
  136. *-- Notes.......: Net present value of array aCashflow[ nPeriods ]
  137. *--               Calculates npv given assumed rate and # periods.
  138. *--               See "Other inputs" below for instructions/details ...
  139. *-- Written for.: dBASE IV, 1.1
  140. *-- Rev. History: 03/01/1992 -- Original Release
  141. *-- Calls.......: None
  142. *-- Called by...: Any
  143. *-- Usage.......: NPV(<nRate>,<nPeriods>)
  144. *-- Example.....: ? NPV( .06, 6 )
  145. *-- Returns.....: Float = value of the project at given rate
  146. *-- Parameters..: nRate    = Interest Rate
  147. *--               nPeriods = Number of Periods to calculate for
  148. *-- Other inputs: Requires the array aCashflow[ ] set up before calling.
  149. *--               Each of its elements [n] holds the cash flow at the
  150. *--               beginning of period n, with a negative amount 
  151. *--               indicating a cash outflow.  Elements of value 0 must 
  152. *--               be included for all periods with no cash flow, and all
  153. *--               periods must be of equal length.
  154. *--                 If the project is expected to require an immediate 
  155. *--               outlay of $6,000 and to return $2,000 at the end of 
  156. *--               each of the first five years thereafter, the array 
  157. *--               will be:
  158. *--                     aCashflow[1] = -6000
  159. *--                     aCashflow[2] =  2000
  160. *--                     aCashflow[3] =  2000
  161. *--                         * * *
  162. *--                     aCashflow[6] =  2000
  163. *--              
  164. *--               If the cash flows are at the end of the periods, 
  165. *--               rather than at the beginning, assign 0 to 
  166. *--               aCashFlow[1], then assign cash flows successively. 
  167. *--               aCashFlow[2] will then represent the cash flow at the
  168. *--               end of period 1, rather than at the beginning of 
  169. *--               period 2, which is the same thing.
  170. *--              
  171. *--                 Rewriting the function to have array name passed as 
  172. *--               a parameter is possible, but will slow down execution 
  173. *--               to an extent that will be very noticeable if this 
  174. *--               function is being repeatedly executed, as by Zeroin()
  175. *--               to find an Internal Rate of Return.
  176. *-----------------------------------------------------------------------
  177.  
  178.    parameters nRate, nPeriods
  179.    private nDiscount, nFactor, nPeriod, nNpv
  180.    m->nPeriod = 1
  181.    m->nNPV = aCashflow[ 1 ]
  182.    m->nDiscount = float( 1 )
  183.    m->nFactor = 1 / ( 1 + m->nRate )
  184.    do while m->nPeriod < m->nPeriods
  185.       m->nPeriod = m->nPeriod + 1
  186.       m->nDiscount = m->nDiscount * m->nFactor
  187.       m->nNPV = m->nNPV + aCashflow[ m->nPeriod ] * m->nDiscount
  188.    enddo
  189.    
  190. RETURN m->nNPV
  191. *-- EoF: NPV()
  192.  
  193. FUNCTION Irr
  194. *-----------------------------------------------------------------------
  195. *-- Programmer..: Jay Parsons (CIS: 72662,1302)
  196. *--               Based on code by Tony Lima (CIS: 72331,3724), 1990.
  197. *-- Date........: 4/13/1992
  198. *-- Notes.......: Finds internal rate of return using Zeroin().
  199. *--               An internal rate of return is an interest rate at
  200. *--               which the net present value of a series of cash flows
  201. *--               is zero.  In the normal case of an investment, where
  202. *--               cash flows out at first, then comes back in later 
  203. *--               periods,  the IRR gives the interest rate for an 
  204. *--               equally-good deal, and investments with higher IRR 
  205. *--               should be considered first.
  206. *--             
  207. *--               As this function uses the Npv() function to evaluate 
  208. *--               the cash flows at each assumed rate, and Npv() 
  209. *--               requires for speed that the cash flows be placed in 
  210. *--               the array aCashflow[], the cash flows must be placed 
  211. *--               there before calling this function.  The number of 
  212. *--               rows in aCashflow[] is a parameter passed through 
  213. *--               by Zeroin() to Npv().
  214. *--              
  215. *-- Written for.: dBASE IV Version 1.5
  216. *-- Rev. History: Original function 1990.
  217. *--               Modified to match Zeroin(), Npv(), 4/13/1992
  218. *-- Calls.......: Zeroin()          Function in STATS.PRG
  219. *--               Arrayrows()       Function in ARRAYS.PRG
  220. *-- Called by...: Any
  221. *-- Usage.......: ? Irr( <fX1>, <fX2>, n_Flag )
  222. *-- Example.....: nRate = Irr( 11, 0, 200, n_Flag )
  223. *-- Returns     : a float value representing Irr, if n_Flag < 3.
  224. *-- Parameters..: fX1    = lowest plausible rate of return from this 
  225. *--                        project.
  226. *--               fX2    = highest plausible rate of return, ditto.
  227. *--               n_Flag = an integer to signal success ( < 3 ) or 
  228. *--                        failure.
  229. *-- Other input.: Requires advance setup of array to be called by Npv,
  230. *--               as furnished "aCashflow[]", to hold cash flows.
  231. *-- Side effects: Uses and alters a global numeric variable, here 
  232. *--               called "n_Flag", to report error conditions resulting 
  233. *--               in value returned being meaningless.
  234. *-----------------------------------------------------------------------
  235.  
  236.    parameters fX1, fX2, n_Flag
  237.  
  238. RETURN Zeroin( "Npv", m->fX1, m->fX2, float( 1 / 10 ^ 6 ), 100, ;
  239.          m->n_Flag, arrayrows( "aCashflow" ) )
  240. *-- EoF: Irr()
  241.  
  242. FUNCTION Irr2 
  243. *----------------------------------------------------------------------
  244. *-- Programmer..: Ron Allen (CIS: 71201,2502)
  245. *-- Date........: 01/25/1993
  246. *-- Notes.......: Returns internal rate of return on an investment from
  247. *--               evenly-spaced periodic cashflows. The UDF 
  248. *--               simultaneously accumulates the periodic Net Present 
  249. *--               Values of the individual cashflows along with the 
  250. *--               first derivative of the function. After the summation 
  251. *--               is completed for each guess, the guess is adjusted by 
  252. *--               subtracting the ratio of the function to its 
  253. *--               derivative.
  254. *-- Written for.: dBASE IV, 1.5
  255. *-- Rev. History: 01/25/1993 -- Original
  256. *--               01/28/1993 - 1.01 -- to add missing private variables.
  257. *--                 To count iterations without sign change in PV. Move
  258. *--                 division by nRatio outside inner loop.
  259. *-- Calls.......: None
  260. *-- Called by...: Any
  261. *-- Usage.......: Irr2(<nN>, <cFlow>, <lSw>, <nGuess>)
  262. *-- Example.....: Rate = Irr2(6, "Cash", Switch, .01)
  263. *-- Returns.....: Internal Rate of Return.
  264. *-- Parameters..: nN     = number of cashflows in model
  265. *--               cFlow  = name of the array holding the cashflows
  266. *--               lSw    = name of a logical variable to be switched to
  267. *--                        indicate valid IRR returned (.t.).
  268. *--               nGuess = optional guess for initialing search.
  269. *-----------------------------------------------------------------------
  270.  
  271.    parameters nN, cFlow, lSw, nGuess
  272.    private nI, nPosVal, nNegVal, nCurVal, nIRR, nNuDelta, nOlDelta, ;
  273.               nBigchange
  274.    private nSignChng, nDiscount, nRatio, nSumPV, nCurrPV, nSumDeriv, ;
  275.               nOldPV
  276.    private nIters, lSw1
  277.    store 0 to m->nI, m->nPosVal, m->nNegVal, m->nIters
  278.    store .t. to m->lSw
  279.    store .f. to m->lSw1
  280.    declare nCashFlow[m->nN]
  281.  
  282.    *--  Transfer cashflows to a private array and separate negatives from
  283.    *--  positives
  284.    do while m->nI < m->nN
  285.       m->nI = m->nI+1
  286.       store &cFlow.[m->nI] to nCashFlow[m->nI], m->nCurVal
  287.       if m->nCurVal < 0
  288.          m->nNegVal = m->nNegVal + m->nCurVal
  289.       else
  290.          m->nPosVal = m->nPosVal + m->nCurVal
  291.       endif
  292.    enddo
  293.    if m->nNegVal = 0 .or. m->nPosVal = 0
  294.       wait "Must have at least one positive and one negative value"
  295.    endif
  296.  
  297.    *-- Use initializing guess if provided, otherwise calculate from
  298.    *-- weighted average returns.
  299.    
  300.    if pcount() = 4
  301.       m->nIRR = m->nGuess
  302.    else
  303.       m->nIRR = ((-m->nPosVal/m->nNegVal)-1)/m->nN
  304.    endif
  305.    
  306.    *-- Housekeeping summary accumulators, etc., before entering loop
  307.    store 1 to m->nNuDelta, m->nOlDelta
  308.    store 0 to m->nSignChng, m->nBigChange
  309.  
  310.    *--  Loop until estimated rate indicated accuracy
  311.    do while abs(m->nNuDelta) > .000001
  312.       store 0 to m->nI, m->nSumPV, m->nSumDeriv
  313.    
  314.       *-- Set up cumulative denominator to calculate 
  315.       *-- incremental NPV
  316.       m->nDiscount = 1
  317.       m->nRatio = 1 + m->nIRR
  318.       do while m->nI < m->nN
  319.          m->nI = m->nI+1
  320.          m->nDiscount = m->nDiscount/m->nRatio
  321.    
  322.          *-- Calculate incremental PV and add to sum
  323.          m->nCurrPV = m->nDiscount * nCashFlow[m->nI]
  324.          m->nSumPV = m->nSumPV + m->nCurrPV
  325.    
  326.          *-- Add incremental first derivative to derivative 
  327.          *-- sum
  328.          m->nSumDeriv = m->nSumDeriv - m->nI * m->nCurrPV
  329.       enddo
  330.    
  331.       *-- count iterations and test for sign change of future value
  332.       if .not. m->lSw1 .and. m->nIters > 0
  333.          m->lSw1 = iif(sign(nOldPV) = sign(m->nSumPV),.f.,.t.)
  334.       endif
  335.       m->nIters = m->nIters + 1
  336.       m->nOldPV = m->nSumPV
  337.  
  338.  
  339.       *-- Calculate indicated change in IRR
  340.       m->nNuDelta = m->nRatio * m->nSumPV/m->nSumDeriv
  341.    
  342.       *-- Test for big changes in adjusted IRR, limit to 10 times
  343.       *-- current guess for IRR and count big changes.
  344.       if abs(m->nNuDelta/m->nIRR) > 10
  345.          m->nNuDelta = sign(m->nNuDelta) * 10 * m->nIRR
  346.          m->nBigChange = m->nBigChange + 1
  347.       endif
  348.       m->nIRR = m->nIRR - m->nNuDelta   && Make adjustment to guess
  349.                                         && for IRR
  350.    
  351.       *-- Count reversals in adjustments to limit hunting
  352.       m->nSignChng = m->nSignChng + iif(sign(m->nNuDelta) + ;
  353.                      sign(m->nOlDelta) = 0,1,0)
  354.       m->nOlDelta = m->nNuDelta
  355.    
  356.       *-- Test for hunting, too many bigchanges or too large a 
  357.       *-- solution and set external switch if abnormal exit is 
  358.       *-- used.
  359.       if m->nSignChng + m->nBigChange > 10 .or. abs(m->nIRR) > 100 ;
  360.         .or. (m->nIters > 9 .and. .not. m->lSw1)
  361.          store .f. to m->lSw
  362.          exit
  363.       endif
  364.    enddo
  365.  
  366. RETURN m->nIRR
  367. *-- EoF: Irr2()
  368.  
  369. FUNCTION Mirr  
  370. *-----------------------------------------------------------------------
  371. *-- Programmer..: Ron Allen (CIS: 71201,2502)
  372. *-- Date........: 01/27/1993
  373. *-- Notes.......: Used to calculate the Modified Internal Rate of Return
  374. *--               for evenly-spaced periodic cashflows. The 
  375. *--               modifications assume that more realistic investment 
  376. *--               models should account for the cost of borrowing or the
  377. *--               lower 'safe' rate for keeping reserve funds to cover 
  378. *--               outlays and the fact that reinvestments will be made 
  379. *--               at some other rate than the IRR itself. This model 
  380. *--               calculates the answer directly, therefore more rapidly
  381. *--               than the iterative approach used by IRR. 
  382. *-- Written for.: dBASE IV, 1.5
  383. *-- Rev. History: 01/27/1993 -- Original Release
  384. *-- Calls.......: None
  385. *-- Called by...: Any
  386. *-- Usage.......: Mirr(<nN>, <cFlow>, <nRrate>, <nFrate>)
  387. *-- Example.....: Rate = Mirr(6, "Cash", .1, .14)
  388. *-- Returns.....: Modified Internal Rate of Return per period.
  389. *-- Parameters..: nN     = number of cashflows in model
  390. *--               cFlow  = name of the array holding the cashflows
  391. *--               nRrate = Reinvestment rate for positive cashflows. 
  392. *--               nFrate = 'Safe' rate expected on reserve funds to 
  393. *--                         cover disbursements.
  394. *-----------------------------------------------------------------------
  395.  
  396.    parameters nN, cFlow, nRrate, nFrate
  397.    private nI, nNegVal, nPosVal, nCurVal
  398.    store 0 to m->nI, m->nNegVal, m->nPosVal
  399.  
  400.    *-- Pass through array once computing present value of negative
  401.    *-- cashflows at 'safe' rate and present value of positive values
  402.    *-- at the reinvestment rate.
  403.    do while m->nI < m->nN
  404.       m->nI = m->nI+1
  405.       m->nCurVal = &cFlow[m->nI].
  406.       m->nCurVal = m->nCurVal*(1+iif(m->nCurVal<0,nFrate,nRrate))^;
  407.                   -(m->nI-1)
  408.       if m->nCurVal < 0
  409.          m->nNegVal = m->nNegVal + m->nCurVal
  410.       else
  411.          m->nPosVal = m->nPosVal + m->nCurVal
  412.       endif
  413.    enddo
  414.    if abs(m->nNegVal) = 0 .or. m->nPosVal = 0
  415.       wait "There must be at least one negative and one positive value!"
  416.       RETURN 0
  417.    endif
  418.  
  419.     *-- Calculate the rate of return required to yield a future value
  420.     *-- of the positive values reinvested at nRrate from the present
  421.     *-- value of the negative values invested at the 'safe' rate.
  422.  
  423. RETURN ((-m->nPosVal * (1+m->nRrate)^(m->nN-1))/m->nNegVal)^;
  424.        (1/(m->nN-1))-1
  425. *-- EoF: Mirr()
  426.  
  427. FUNCTION Xmirr  
  428. *-----------------------------------------------------------------------
  429. *-- Programmer..: Ron Allen (CIS: 71201,2502)
  430. *-- Date........: 01/27/1993
  431. *-- Notes.......: Used to calculate the Modified Internal Rate of Return
  432. *--               from cashflows on random dates. Except for the need to 
  433. *--               supply both the dates of transactions and the 
  434. *--               cashflows in an 'nN' by 2 array, the other inputs are 
  435. *--               the same as in Mirr(). Dates may be in random order 
  436. *--               except for the first date. The first date in the array
  437. *--               establishes the date to which present value applies. 
  438. *--               Enter 'Safe' rate for reserves and 'Reinvestment' rate
  439. *--               for positive cashflows as annual rates, e.g., .075 for
  440. *--               7.5%. 
  441. *-- Written for.: dBASE IV, 1.5
  442. *-- Rev. History: 01/27/1993 -- 1.01 - to allow entry of 'Safe' reserve 
  443. *--                 rate and 'Reinvestment' rate as annual rates rather 
  444. *--                 than rates. Also, to return the 'effective' rate of
  445. *--                 interest when compounded daily, rather than the 
  446. *--                 'nominal' rate.
  447. *-- Calls.......: None
  448. *-- Called by...: Any
  449. *-- Usage.......: Xmirr(<nN>, <cFlow>, <nRrate>, <nFrate>)
  450. *-- Example.....: Rate = Xmirr(5, "Cash", .14, .1)
  451. *-- Returns.....: Annualized Effective Modified Internal Rate of Return 
  452. *--               based on daily compounded interest.   
  453. *-- Parameters..: nN     = number of cashflows in model
  454. *--               cFlow  = name of 'nN' by 2 array holding the dates 
  455. *--                        (col 1) and cashflow amounts (col 2). 
  456. *--               nRrate = Reinvestment rate for positive cashflows. 
  457. *--               nFrate = 'Safe' rate expected on reserve funds to 
  458. *--                         cover disbursements.
  459. *-----------------------------------------------------------------------
  460.  
  461.    parameters nN, cFlow, nRrate, nFrate
  462.    private nI, nCurVal, nNegVal, nPosVal, dPDate
  463.    private dMaxDate, dCurDate, nCurN, nMirr
  464.  
  465.    store 0 to m->nI, m->nNegVal, m->nPosVal
  466.    store (1+m->nRrate)^(1/365)-1 to m->nRrate
  467.    store (1+m->nFrate)^(1/365)-1 to m->nFrate
  468.    store &cFlow.[1,1] to m->dPDate
  469.    m->dMaxDate = m->dPDate
  470.  
  471.    do while m->nI < m->nN
  472.       m->nI = m->nI+1
  473.       m->nCurVal = &cFlow.[m->nI,2]
  474.       m->dCurDate = &cFlow.[m->nI,1]
  475.       m->dMaxDate = max(m->dCurDate,m->dMaxDate)
  476.       m->nCurN = m->dCurDate-m->dPDate
  477.       m->nCurVal = m->nCurVal/(1+iif(m->nCurVal<0,m->nFrate,;
  478.                    m->nRrate))^m->nCurN
  479.       if m->nCurVal < 0
  480.           m->nNegVal = m->nNegVal + m->nCurVal
  481.       else
  482.           m->nPosVal = m->nPosVal + m->nCurVal
  483.       endif
  484.    enddo
  485.    if m->nNegVal = 0 .or. m->nPosVal = 0
  486.       wait;
  487.        " There must be at least one negative and one positive value! "
  488.       RETURN 0
  489.    endif
  490.    m->nN = m->dMaxDate - m->dPDate
  491.    m->nMirr = ((-m->nPosVal * (1+m->nRrate)^(m->nN-1))/m->nNegVal)^;
  492.             (1/(m->nN-1))-1
  493.  
  494. RETURN (1+m->nMirr)^365-1
  495. *-- EoF: Xmirr()
  496.  
  497. FUNCTION Xirr   
  498. *-----------------------------------------------------------------------
  499. *-- Programmer..: Ron Allen (CIS: 71201,2502)
  500. *-- Date........: 01/25/1993
  501. *-- Notes.......: Used to calculate the Internal Rate of Return from
  502. *--               cashflows on random dates. Except for the need to 
  503. *--               supply both the dates of transactions and the 
  504. *--               cashflows in an 'nN' by 2 array, the other inputs are
  505. *--               the same as in Irr(). Dates may be in random order 
  506. *--               except for the first date. The first date in the array
  507. *--               establishes the date to which present value applies.
  508. *-- Written for.: dBASE IV, 1.5
  509. *-- Rev. History: 01/25/1993 -- Original
  510. *--               01/28/1993 - 1.01 -- to return 'effective' rate of 
  511. *--               interest when compounded daily rather than the 
  512. *--               'nominal' rate.  Also to count iterations without a 
  513. *--               sign change in PV. Move division by nRatio outside 
  514. *--               inner loop.
  515. *-- Calls.......: None
  516. *-- Called by...: Any
  517. *-- Usage.......: Irr(<nN>, <cFlow>, <lSw>, <nGuess>)
  518. *-- Example.....: Rate = Irr(5, "Cash", "Switch", .01)
  519. *-- Returns.....: Effective Internal Rate of Return.
  520. *-- Parameters..: nN     = number of cashflows in model
  521. *--               cFlow  = name of the 'nN' by 2 array holding the 
  522. *--                        dates (col 1) and cashflows (col 2). Dates
  523. *--                        may be entered in any order except for the 
  524. *--                        date, which is the date to which present
  525. *--                        value applies.
  526. *--               lSw    = name of a logical variable to be switched to
  527. *--                        indicate valid IRR returned (.t.).
  528. *--               nGuess = optional guess for initializing search.
  529. *-----------------------------------------------------------------------
  530.  
  531.    parameters nN, cFlow, lSw, nGuess
  532.    private nI, nPosVal, nNegVal, nCurVal, nIRR, nNuDelta, nOlDelta, ;
  533.            nBigchange
  534.    private nSignChng, nRatio, dPDate, dMaxDate, nCurrPV, nSumDeriv
  535.    private nSumPV, dCurDate, nIters, lSw1
  536.  
  537.    store 0 to m->nI, m->nPosVal, m->nNegVal, m->nIters
  538.    store .t. to m->lSw
  539.    declare nCashFlow[m->nN,2]
  540.    store &cFlow.[1,1] to m->dMaxDate, m->dPDate
  541.    store .f. to m->lSw1
  542.  
  543.    *-- Transfer cashflows to a private array and separate negatives from
  544.    *-- positives. Find last date. 
  545.    do while m->nI < m->nN
  546.       m->nI = m->nI+1
  547.       store &cFlow.[m->nI,1] to nCashFlow[m->nI,1], m->dCurDate
  548.       store &cFlow.[m->nI,2] to nCashFlow[m->nI,2], m->nCurVal
  549.       store max(m->dCurDate,m->dMaxDate) to m->dMaxDate
  550.       if m->nCurVal < 0
  551.          m->nNegVal = m->nNegVal + m->nCurVal
  552.       else
  553.          m->nPosVal = m->nPosVal + m->nCurVal
  554.       endif
  555.    enddo
  556.    if m->nNegVal = 0 .or. m->nPosVal = 0
  557.       wait "Must have at least one positive and one negative value"
  558.    endif
  559.  
  560.    *-- Use initializing guess if provided, otherwise calculate from
  561.    *-- weighted average returns.
  562.    if pcount() = 4
  563.       m->nIRR = m->nGuess
  564.    else
  565.       m->nIRR = (((m->nPosVal+m->nNegVal-ncashflow[1,2])/-;
  566.                 nCashFlow[1,2])-1)/(m->dMaxDate-m->dPDate)
  567.    endif
  568.  
  569.    *-- Housekeeping summary accumulators, etc., before entering loop
  570.    store 1 to m->nNuDelta, m->nOlDelta
  571.    store 0 to m->nSignChng, m->nBigChange
  572.  
  573.    *-- Loop until estimated rate indicated accuracy
  574.    do while abs(m->nNuDelta) > .000001
  575.       store 0 to m->nI, m->nSumPV, m->nSumDeriv
  576.       store 1 + m->nIrr to m->nRatio
  577.       do while m->nI < m->nN
  578.          m->nI = m->nI+1
  579.     
  580.          *-- Calculate incremental PV and add to sum
  581.          m->nCurrPV =  nCashFlow[m->nI,2] / m->nRatio^;
  582.                        (nCashFlow[m->nI,1] - m->dPDate)
  583.          m->nSumPV = m->nSumPV + m->nCurrPV
  584.    
  585.          *-- Add incremental first derivative to derivative 
  586.          *-- sum
  587.          m->nSumDeriv = m->nSumDeriv - (nCashFlow[m->nI,1] -;
  588.                         m->dPDate) * m->nCurrPV
  589.       enddo
  590.  
  591.       *-- count iterations and test for sign change of future value
  592.       if .not. m->lSw1 .and. m->nIters > 0
  593.            m->lSw1 = iif(sign(m->nOldPV) = sign(m->nSumPV),.f.,.t.)
  594.       endif
  595.       m->nIters = m->nIters + 1
  596.       m->nOldPV = m->nSumPV
  597.    
  598.       *-- Calculate indicated change in IRR
  599.       m->nNuDelta = m->nRatio * m->nSumPV/m->nSumDeriv
  600.    
  601.       *-- Test for big changes in adjusted IRR, limit to 10 times
  602.       *-- current guess for IRR and count big changes.
  603.       if abs(m->nNuDelta/m->nIRR) > 10
  604.          m->nNuDelta = sign(m->nNuDelta) * 10 * m->nIRR
  605.          m->nBigChange = m->nBigChange + 1
  606.       endif
  607.       m->nIRR = m->nIRR - m->nNuDelta   
  608.                              && Make adjustment to guess for IRR
  609.    
  610.       *-- Count reversals in adjustments to limit hunting
  611.       m->nSignChng = m->nSignChng + iif(sign(m->nNuDelta) + ;
  612.                      sign(m->nOlDelta) = 0,1,0)
  613.       m->nOlDelta = m->nNuDelta
  614.    
  615.       *-- Test for hunting, too many bigchanges or too large a 
  616.       *-- solution and set external switch if abnormal exit is 
  617.       *-- used.
  618.       if m->nSignChng + m->nBigChange > 10 .or. abs(m->nIRR) > 100;
  619.          .or. (m->nIters > 9 .and. .not. m->lSw1)
  620.          store .f. to m->lSw
  621.          exit
  622.       endif
  623.    enddo
  624.  
  625. RETURN (1+m->nIrr)^365 -1
  626. *-- EoF: Xirr()
  627.  
  628. FUNCTION FVirr 
  629. *-----------------------------------------------------------------------
  630. *-- Programmer..: Ron Allen (CIS: 71201,2502)
  631. *-- Date........: 01/28/1993
  632. *-- Notes.......: Returns same roots as Irr(), but averages 20% faster. 
  633. *--               Irr() searches for the roots of NPV (Net Present 
  634. *--               Value), while FVirr() searches for the same roots of 
  635. *--               NFV (Net Future Value), both with respect to the rate 
  636. *--               of return. The user may wish to use this UDF in place
  637. *--               of Irr() and use Irr() as an alternate to help locate 
  638. *--               more multiple solutions. The reason this UDF is 
  639. *--               'usually' faster is due to the fact that the NFV curve
  640. *--               is 'usually' steeper as it crosses the zero axis.
  641. *-- Written for.: dBASE IV, 1.5
  642. *-- Rev. History: 01/28/1993 -- Original
  643. *--               01/28/1993 -- 1.01 - Modified Irr() to use Net Future 
  644. *--               Value curve instead of Net Present Value curve.
  645. *-- Calls.......: None
  646. *-- Called by...: Any
  647. *-- Usage.......: Irr(<nN>, <cFlow>, <lSw>, <nGuess>)
  648. *-- Example.....: Rate = Irr(6, "Cash", Switch, .01)
  649. *-- Returns.....: Internal Rate of Return.
  650. *-- Parameters..: nN     = number of cashflows in model
  651. *--               cFlow  = name of the array holding the cashflows
  652. *--               lSw    = name of a logical variable to be switched to
  653. *--                        indicate valid IRR returned (.t.).
  654. *--               nGuess = optional guess for initialing search.
  655. *-----------------------------------------------------------------------
  656.  
  657.    parameters nN, cFlow, lSw, nGuess
  658.    private nI, nPosVal, nNegVal, nCurVal, nIRR, nNuDelta, nOlDelta, ;
  659.              nBigchange
  660.    private nSignChng, nDiscount, nRatio, nSumFV, nCurrFV, nSumDeriv, ;
  661.              nOldFV
  662.    private nIters, lSw1
  663.  
  664.    store 0 to m->nI, m->nPosVal, m->nNegVal, m->nIters
  665.    store .t. to m->lSw
  666.    store .f. to m->lSw1
  667.    declare nCashFlow[m->nN]
  668.  
  669.    *-- Transfer cashflows to a private array and separate negatives from
  670.    *-- positives
  671.    do while m->nI < m->nN
  672.       m->nI = m->nI+1
  673.       store &cFlow.[m->nI] to nCashFlow[m->nI], m->nCurVal
  674.       if m->nCurVal < 0
  675.          m->nNegVal = m->nNegVal + m->nCurVal
  676.       else
  677.          m->nPosVal = m->nPosVal + m->nCurVal
  678.       endif
  679.    enddo
  680.    if m->nNegVal = 0 .or. m->nPosVal = 0
  681.       wait "Must have at least one positive and one negative value"
  682.    endif
  683.  
  684.    *-- Use initializing guess if provided, otherwise calculate from
  685.    *-- weighted average returns.
  686.    if pcount() = 4
  687.       m->nIRR = m->nGuess
  688.    else
  689.       m->nIRR = ((-m->nPosVal/m->nNegVal)-1)/m->nN
  690.    endif
  691.    
  692.    *-- Housekeeping summary accumulators, etc., before entering loop
  693.    store 1 to m->nNuDelta, m->nOlDelta
  694.    store 0 to m->nSignChng, m->nBigChange
  695.  
  696.    *-- Loop until estimated rate indicated accuracy
  697.    do while abs(m->nNuDelta) > .000001
  698.       store 0 to m->nI, nSumFV, m->nSumDeriv
  699.    
  700.       *-- Set up cumulative denominator to calculate 
  701.       *-- incremental NFV
  702.       m->nRatio = 1 + m->nIRR
  703.       m->nDiscount = m->nRatio^m->nN
  704.       do while m->nI < m->nN
  705.          m->nI = m->nI+1
  706.          m->nDiscount = m->nDiscount/m->nRatio
  707.    
  708.          *-- Calculate incremental FV and add to sum
  709.          m->nCurrFV = m->nDiscount * nCashFlow[m->nI]
  710.          m->nSumFV = m->nSumFV + m->nCurrFV
  711.    
  712.          *-- Add incremental first derivative to derivative 
  713.          *-- sum
  714.          m->nSumDeriv = m->nSumDeriv - m->nI * m->nCurrFV
  715.       enddo
  716.    
  717.       *-- count iterations and test for sign change of future value
  718.       if .not. m->lSw1 .and. m->nIters > 0
  719.            m->lSw1 = iif(sign(m->nOldFV) = sign(m->nSumFV),.f.,.t.)
  720.       endif
  721.       m->nIters = m->nIters + 1
  722.       m->nOldFV = m->nSumFV
  723.  
  724.       *-- Calculate indicated change in IRR
  725.       m->nNuDelta = m->nRatio * m->nSumFV/m->nSumDeriv
  726.    
  727.       *-- Test for big changes in adjusted IRR, limit to 10 times
  728.       *-- current guess for IRR and count big changes.
  729.       if abs(m->nNuDelta/m->nIRR) > 10
  730.          m->nNuDelta = sign(m->nNuDelta) * 10 * m->nIRR
  731.          m->nBigChange = m->nBigChange + 1
  732.       endif
  733.       m->nIRR = m->nIRR - m->nNuDelta   
  734.                             && Make adjustment to guess for IRR
  735.    
  736.       *-- Count reversals in adjustments to limit hunting
  737.       m->nSignChng = m->nSignChng + iif(sign(m->nNuDelta) +;
  738.                      sign(m->nOlDelta) = 0,1,0)
  739.       m->nOlDelta = m->nNuDelta
  740.    
  741.       *-- Test for hunting, too many bigchanges or too large a 
  742.       *-- solution and set external switch if abnormal exit is 
  743.       *-- used.
  744.       if m->nSignChng + m->nBigChange > 10 .or. abs(m->nIRR) >;
  745.             100 .or. (m->nIters > 9 .and. .not. m->lSw1)
  746.          store .f. to m->lSw
  747.          exit
  748.       endif
  749.    enddo
  750.  
  751. RETURN m->nIRR
  752. *-- EoF: FVirr()
  753.  
  754. FUNCTION FVxirr 
  755. *-----------------------------------------------------------------------
  756. *-- Programmer..: Ron Allen (CIS: 71201,2502)
  757. *-- Date........: 01/28/1993
  758. *-- Notes.......: Same as Xirr() except that the Net Future Value (NFV)
  759. *--               function is used instead of the Net Present Value 
  760. *--               (NPV) function. The roots are the same, but this 
  761. *--               function is usually faster for the same reasons that 
  762. *--               FVirr() is faster than Irr(). As in Xirr(), all dates
  763. *--               except the first date in the array may be in random 
  764. *--               order. The first date in the nN by 2 array along with
  765. *--               the maximum date establishes the range of the 
  766. *--               investment analysis. 
  767. *-- Written for.: dBASE IV, 1.5
  768. *-- Rev. History: 01/28/1993
  769. *--               01/28/1993 -- 1.01 - Modified Xirr() to find roots of 
  770. *--                 the Net Future Value curve.
  771. *-- Calls.......: None
  772. *-- Called by...: Any
  773. *-- Usage.......: Irr(<nN>, <cFlow>, <lSw>, <nGuess>)
  774. *-- Example.....: Rate = Irr(5, "Cash", Switch, .01)
  775. *-- Returns.....: Effective Internal Rate of Return.
  776. *-- Parameters..: nN     = number of cashflows in model
  777. *--               cFlow  = name of the 'nN' by 2 array holding the 
  778. *--                        dates (col 1) and cashflows (col 2). Dates
  779. *--                        may be entered in any order except for the 
  780. *--                        date, which is the date to which present
  781. *--                        value applies.
  782. *--               lSw    = name of a logical variable to be switched to
  783. *--                        indicate valid IRR returned (.t.).
  784. *--               nGuess = optional guess for initializing search.
  785. *-----------------------------------------------------------------------
  786.  
  787.    parameters nN, cFlow, lSw, nGuess
  788.    private nI, nPosVal, nNegVal, nCurVal, nIRR, nNuDelta, nOlDelta, ;
  789.               nBigchange
  790.    private nSignChng, nRatio, dPDate, dMaxDate, nCurrFV, nSumDeriv
  791.    private nSumFV, dCurDate, lSw1, nIters
  792.  
  793.    store 0 to m->nI, m->nPosVal, m->nNegVal, m->nIters
  794.    store .t. to m->lSw
  795.    declare nCashFlow[m->nN,2]
  796.    store &cFlow.[1,1] to m->dMaxDate, m->dPDate
  797.  
  798.    *-- Transfer cashflows to a private array and separate negatives from
  799.    *-- positives. Find last date. 
  800.    
  801.    do while m->nI < m->nN
  802.       m->nI = m->nI+1
  803.       store &cFlow.[m->nI,1] to nCashFlow[m->nI,1], m->dCurDate
  804.       store &cFlow.[m->nI,2] to nCashFlow[m->nI,2], m->nCurVal
  805.       store max(m->dCurDate,m->dMaxDate) to m->dMaxDate
  806.       if m->nCurVal < 0
  807.          m->nNegVal = m->nNegVal + m->nCurVal
  808.       else
  809.          m->nPosVal = m->nPosVal + m->nCurVal
  810.       endif
  811.    enddo
  812.    if m->nNegVal = 0 .or. m->nPosVal = 0
  813.       wait "Must have at least one positive and one negative value"
  814.    endif
  815.  
  816.    *-- Use initializing guess if provided, otherwise calculate from
  817.    *-- weighted average returns.
  818.    if pcount() = 4
  819.       m->nIRR = m->nGuess
  820.    else
  821.       m->nIRR = (((m->nPosVal+m->nNegVal-ncashflow[1,2])/-;
  822.                  nCashFlow[1,2])-1)/(m->dMaxDate-m->dPDate)
  823.    endif
  824.  
  825.    *-- Housekeeping summary accumulators, etc., before entering loop
  826.    store 1 to m->nNuDelta, m->nOlDelta
  827.    store 0 to m->nSignChng, m->nBigChange
  828.    store .f. to m->lSw1
  829.  
  830.    *-- Loop until estimated rate indicated accuracy
  831.    do while abs(m->nNuDelta) > .000001
  832.       store 0 to m->nI, m->nSumFV, m->nSumDeriv
  833.       store 1 + m->nIrr to m->nRatio
  834.       do while m->nI < m->nN
  835.          m->nI = m->nI+1
  836.    
  837.          *-- Calculate incremental FV and add to sum
  838.          m->nCurrFV =  nCashFlow[m->nI,2] * m->nRatio^;
  839.                        (m->dMaxDate - nCashFlow[m->nI,1])
  840.          m->nSumFV = m->nSumFV + m->nCurrFV
  841.    
  842.          *-- Add incremental first derivative to derivative 
  843.          *-- sum
  844.          m->nSumDeriv = m->nSumDeriv + (m->dMaxDate - ;
  845.                         nCashFlow[m->nI,1]) * m->nCurrFV
  846.       enddo
  847.    
  848.       *-- count iterations and test for sign change of future value
  849.       if .not. m->lSw1 .and. m->nIters > 0
  850.          m->lSw1 = iif(sign(m->nOldFV) = sign(m->nSumFV),.f.,.t.)
  851.       endif
  852.       m->nIters = m->nIters + 1
  853.       m->nOldFV = m->nSumFV
  854.  
  855.       *-- Calculate indicated change in IRR
  856.       m->nNuDelta = m->nRatio * m->nSumFV/m->nSumDeriv
  857.  
  858.       *-- Test for big changes in adjusted IRR, limit to 10 times
  859.       *-- current guess for IRR and count big changes.
  860.       if abs(m->nNuDelta/m->nIRR) > 10
  861.          m->nNuDelta = sign(m->nNuDelta) * 10 * m->nIRR
  862.          m->nBigChange = m->nBigChange + 1
  863.       endif
  864.       m->nIRR = m->nIRR - m->nNuDelta   
  865.                                 && Make adjustment to guess for IRR
  866.    
  867.       *-- Count reversals in adjustments to limit hunting
  868.       m->nSignChng = m->nSignChng + iif(sign(m->nNuDelta) + ;
  869.                        sign(m->nOlDelta) = 0,1,0)
  870.       m->nOlDelta = m->nNuDelta
  871.  
  872.       *-- Test for hunting, too many bigchanges or too large a 
  873.       *-- solution and set external switch if abnormal exit is 
  874.       *-- used.
  875.       if m->nSignChng + m->nBigChange > 10 .or. abs(m->nIRR) > 100;
  876.           .or. (m->nIters > 9 .and. .not. m->lSw1)
  877.          store .f. to m->lSw
  878.          exit
  879.       endif
  880.    enddo
  881.  
  882. RETURN (1+m->nIrr)^365 -1
  883. *-- EoF: FVxirr()
  884.  
  885. *-----------------------------------------------------------------------
  886. *-- Note: The following functions are here as a courtesy, as they are 
  887. *-- used in at least one of the functions above.
  888. *-----------------------------------------------------------------------
  889.  
  890. FUNCTION Zeroin
  891. *-----------------------------------------------------------------------
  892. *-- Programmer..: Tony Lima (CIS: 72331,3724) and 
  893. *--               Jay Parsons (CIS: 72662,1302)
  894. *-- Date........: 04/13/1992
  895. *-- Notes.......: Finds a zero of a continuous function.
  896. *--               In substance, what this function does is close in on a
  897. *--               solution to a function that cannot otherwise be 
  898. *--               solved. Assuming Y = f(X), if Y1 and Y2, the values of
  899. *--               the function for X1 and X2, have different signs, 
  900. *--               there must be at least one value of X between X1 and 
  901. *--               X2 for which Y = 0, if the function is continuous.  
  902. *--               This function closes in on such a value of X by a 
  903. *--               trial-and-error process.
  904. *--              
  905. *--               This function is very slow, so a maximum number of 
  906. *--               iterations is passed as a parameter.  If the number 
  907. *--               of iterations is exceeded, the function will fail to 
  908. *--               find a root.  If this occurs, pick different original
  909. *--               "X" values, increase the number of iterations or 
  910. *--               increase the errors allowed.  Once an approximate root
  911. *--               is found, you can use values of X close on either side
  912. *--               and reduce the error allowed to find an improved 
  913. *--               solution.  Also, of course, the signs of Y must be
  914. *--               different for the starting X values for the function 
  915. *--               to proceed at all.
  916. *--              
  917. *--               NOTE ESPECIALLY - There is NO guarantee that a root 
  918. *--               returned by this function is the only one, or the 
  919. *--               most meaningful. It depends on the function that this
  920. *--               function calls, but if that function has several 
  921. *--               roots, any of them may be returned. This can easily 
  922. *--               happen with such called functions as net present value
  923. *--               where the cash flows alternate from positive
  924. *--               to negative and back, and in many other "real life" 
  925. *--               cases. See the discussion of @IRR in the documentation
  926. *--               of a good spreadsheet program such as Quattro Pro for 
  927. *--               further information.
  928. *--              
  929. *--               The method used by this function is a "secant and 
  930. *--               bisect" search.  The "secant" is the line connecting
  931. *--               two X,Y points on a graph using standard Cartesian 
  932. *--               coordinates. Where the secant crosses the X axis is 
  933. *--               the best guess for the value of X that will have 
  934. *--               Y = 0, and will be correct if the function is linear 
  935. *--               between the two points.  The basic strategy is to 
  936. *--               calculate Y at that value of X, then keep the new X 
  937. *--               and that one of the old X values that had a Y-value 
  938. *--               of opposite sign, and reiterate to close in.
  939. *--              
  940. *--               If the function is a simple curve with most of the 
  941. *--               change in Y close to one of the X-values, as often 
  942. *--               occurs if the initial values of X are poorly chosen, 
  943. *--               repeated secants will do little to find a Y-value 
  944. *--               close to zero and will reduce the difference in 
  945. *--               X-values only slightly.  In this case the function 
  946. *--               shifts to choosing the new X halfway between the 
  947. *--               old ones, bisecting the difference and always
  948. *--               reducing the bracket by half, for a while.
  949. *--              
  950. *--               While this function finds a "zero", it may be used 
  951. *--               to find an X corresponding to any other value of Y.
  952. *--               Suppose the function of X is FUNCTION Blackbox( X ) 
  953. *--               and it is desired to find a value of X for which 
  954. *--               f(X) = 7.  The trick is to interpose a function 
  955. *--               between Zeroin() and Blackbox() that will return a 
  956. *--               0 to Zeroin() whenever Blackbox() returns 7.  By 
  957. *--               calling that function, Zeroin() finds a value of
  958. *--               X for which Blackbox( X ) = 7, as required:
  959. *--                 Result = Zeroin( "Temp", <other parameters omitted>)
  960. *--              
  961. *--                  FUNCTION Temp
  962. *--                  parameters nQ
  963. *--                  RETURN Blackbox( nQ ) - 7
  964. *--              
  965. *-- Written for.: dBASE IV, 1.5
  966. *-- Rev. History: Original function 1990.
  967. *--               Modified to take optional parameters, 4/13/1992
  968. *-- Calls.......: The function whose name is first parameter.
  969. *-- Called by...: Any
  970. *-- Usage.......: Zeroin( <cFunction>, <m->fX1>, <fX2>, <fAbserror>, ;
  971. *--                <nMaxiter>, <n_Flag> ;
  972. *--                [, xPass1 [, xPass2 [, xPass3 ] ] ] )
  973. *-- Example.....: ? Zeroin( "Npv", 0, 200, .000001, 200, n_Flag, 11 )
  974. *-- Returns.....: a float value representing a root, if n_Flag < 3.
  975. *-- Parameters..: cFunction = the name of the function to solve for a 
  976. *--                           root.
  977. *--               fX1       = one of the X-values between which the root 
  978. *--                           is sought.
  979. *--               fX2       = the second of these values.
  980. *--               Note: These MUST be chosen so the f( X ) values for 
  981. *--                     the two of them have opposite signs (they must
  982. *--                     bracket the result).
  983. *--               fAbserror = the absolute error allowed in the result.
  984. *--               nMaxiter  = the maximum number of times to iterate.
  985. *--               n_Flag    = an integer to signal success ( < 3 ) or 
  986. *--                           failure.
  987. *--               xPass1 . . . 3 = arguments to be passed through to 
  988. *--                                cFunction.
  989. *--               The parameter "n_Flag" should be passed as a variable 
  990. *--               so it may be accessed on return.  The limit of 9 
  991. *--               literal parameters may require passing others as 
  992. *--               variables.  The "xPass" parameters are optional and 
  993. *--               the fact there are three of them is arbitrary; they 
  994. *--               exist to hold whatever parameters may be needed by 
  995. *--               the function cFunction being called aside from
  996. *--               the value of X for which it is being evaluated.  
  997. *--               Add more and change the 3 "&cFunc." lines below if 
  998. *--               you need more.
  999. *-- Side effects: Uses and alters a global numeric variable, here called
  1000. *--               "n_Flag", to report error conditions resulting in 
  1001. *--               value returned being meaningless.  Possible n_Flag 
  1002. *--               values are:
  1003. *--                     1       success - root found within error 
  1004. *--                                       allowed
  1005. *--                     2       success - root was found exactly
  1006. *--                     3       error   - function value not converging
  1007. *--                     4       error   - original values do not bracket 
  1008. *--                                       a root
  1009. *--                     5       error   - maximum iterations exceeded
  1010. *-----------------------------------------------------------------------
  1011.  
  1012.    parameters cFunc, fNearx, fFarx, fAbserr, nMaxiter, ;
  1013.               n_Flag, xPass1, xPass2, xPass3
  1014.    private nSplits, fBracket, fFary, fNeary, nIters
  1015.    private fMaxabs, fOldx, fOldy, fDiffx, fAbsdiff, fSecant
  1016.  
  1017.    store 0 to m->nSplits, m->nIters
  1018.    m->fBracket = abs ( m->fNearX - m->fFarX )
  1019.    m->fFarY = &cFunc.( m->fFarX, m->xPass1, m->xPass2, m->xPass3 )
  1020.    m->fNearY = &cFunc.( m->fNearX, m->xPass1, m->xPass2, m->xPass3 )
  1021.  
  1022.    if sign( m->fNearY ) = sign( m->fFarY )
  1023.       m->n_Flag = 4
  1024.       return float(0)
  1025.    endif
  1026.  
  1027.    m->fMaxAbs = max( abs( m->fNearY ), abs( m->fFarY ) )
  1028.    m->n_Flag = 0
  1029.  
  1030.    * Main iteration loop
  1031.  
  1032.    do while .t.
  1033.  
  1034.       if abs( m->fFarY ) < abs( m->fNearY )
  1035.  
  1036.          * Interchange fNearX and fFarx so that
  1037.          * fNearX is closer to a solution--
  1038.          * abs( fNearY ) <= abs( fFary )
  1039.  
  1040.          m->fOldX  = m->fNearX
  1041.          m->fOldY  = m->fNearY
  1042.          m->fNearX = m->fFarX
  1043.          m->fNearY = m->fFarY
  1044.          m->fFarX  = m->fOldX
  1045.          m->fFarY  = m->fOldY
  1046.       endif
  1047.  
  1048.       m->fDiffX = m->fFarX - m->fNearX
  1049.       m->fAbsDiff = abs( m->fDiffX )
  1050.  
  1051.       * Test whether interval is too small to continue
  1052.  
  1053.       if m->fAbsDiff <= 2 * m->fAbsErr
  1054.          if abs( m->fNearY ) > m->fMaxAbs
  1055.  
  1056.             * Yes, but we are out of bounds
  1057.  
  1058.             m->n_Flag = 3
  1059.             m->fNearX = float(0)
  1060.          else
  1061.  
  1062.             * Yes, and we have a solution!
  1063.  
  1064.             m->n_Flag = 1
  1065.          endif
  1066.          exit
  1067.       endif
  1068.  
  1069.       * Save the last approximation to x and y
  1070.  
  1071.       m->fOldX = m->fNearX
  1072.       m->fOldY = m->fNearY
  1073.  
  1074.       * Check if reduction in the size of
  1075.       * bracketing interval is satisfactory.
  1076.       * If not, bisect until it is.
  1077.  
  1078.       m->nSplits = m->nSplits + 1
  1079.       if m->nSplits >= 4
  1080.          if 4 * m->fAbsDiff >= m->fBracket
  1081.             m->fNearX = m->fNearX + m->fDiffX / 2
  1082.          else
  1083.             m->nSplits = 0
  1084.             m->fBracket = m->fAbsDiff / 2
  1085.  
  1086.             * Calculate secant
  1087.  
  1088.             m->fSecant = ( m->fNearX - m->fFarX ) * m->fNearY ;
  1089.                                / ( m->fFarY - m->fNearY )
  1090.  
  1091.             * But not less than error allowed
  1092.  
  1093.             if abs( m->fSecant ) < m->fAbsErr
  1094.                m->fNearX = m->fNearX + m->fAbsErr * sign( m->fDiffX )
  1095.             else
  1096.                m->fNearX = m->fNearX + m->fSecant
  1097.             endif
  1098.          endif
  1099.       endif
  1100.  
  1101.       * Evaluate the function at the new approximation
  1102.  
  1103.       m->fNearY = &cFunc.( m->fNearX, m->xPass1, m->xPass2, m->xPass3 )
  1104.  
  1105.       * If it's exactly zero, we win!  Run with it
  1106.  
  1107.       if m->fNearY = 0.00
  1108.          m->n_Flag = 2
  1109.          exit
  1110.       endif
  1111.  
  1112.       * Else adjust iteration count and quit if too
  1113.       * many iterations with no solution
  1114.  
  1115.       m->nIters = m->nIters + 1
  1116.       if m->nIters > nMaxiter
  1117.          m->n_Flag = 5
  1118.          m->fNearX = float( 0 )
  1119.          exit
  1120.       endif
  1121.  
  1122.       * And finally keep as the new fFarx that one
  1123.       * of the previous approximations, fFarx and
  1124.       * fOldx, at which the function has a sign opposite
  1125.       * to that at the new approximation, fNearx.
  1126.  
  1127.       if sign( m->fNearY ) = sign( m->fFarY )
  1128.          m->fFarX = m->fOldX
  1129.          m->fFarY = m->fOldY
  1130.       endif
  1131.    enddo
  1132.  
  1133. RETURN m->fNearX
  1134. *-- EoF: Zeroin()
  1135.  
  1136. FUNCTION ArrayRows
  1137. *-----------------------------------------------------------------------
  1138. *-- Programmer..: Jay Parsons (CIS: 72662,1302)
  1139. *-- Date........: 03/01/1992
  1140. *-- Notes.......: Number of Rows in an array
  1141. *-- Written for.: dBASE IV, 1.1
  1142. *-- Rev. History: 03/01/1992 -- Original Release
  1143. *-- Calls.......: None
  1144. *-- Called by...: Any
  1145. *-- Usage.......: ArrayRows("<aArray>")
  1146. *-- Example.....: n = ArrayRows("aTest")
  1147. *-- Returns.....: numeric
  1148. *-- Parameters..: aArray      = Name of array 
  1149. *-----------------------------------------------------------------------
  1150.  
  1151.    parameters aArray
  1152.    private nHi, nLo, nTrial, nDims
  1153.    m->nLo = 1
  1154.    m->nHi = 1170
  1155.    if type( "&aArray.[ 1, 1 ]" ) = "U"
  1156.      m->nDims = 1
  1157.    else
  1158.           m->nDims = 2
  1159.    endif
  1160.    do while .T.
  1161.            m->nTrial = int( ( m->nHi + m->nLo ) / 2 )
  1162.       if m->nHi < m->nLo
  1163.          exit
  1164.       endif
  1165.       if m->nDims = 1 .and. type( "&aArray.[ m->nTrial ]" ) = "U" ;
  1166.           .or. m->nDims = 2 .and. type("&aArray.[ m->nTrial, 1 ]");
  1167.            = "U"
  1168.         m->nHi = m->nTrial - 1
  1169.       else
  1170.         m->nLo = m->nTrial + 1
  1171.       endif
  1172.    enddo
  1173.    
  1174. RETURN m->nTrial
  1175. *-- EoF: ArrayRows()
  1176.  
  1177. *-----------------------------------------------------------------------
  1178. *-- EoP: FINANCE.PRG
  1179. *-----------------------------------------------------------------------
  1180.